perm filename NOTSUB.F4[RST,LCS] blob
sn#207686 filedate 1976-03-23 generic text, type T, neo UTF8
00010 C********** FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
00100 SUBROUTINE NOTWRT
00200 IMPLICIT INTEGER(A-Q,S-Z)
00300 COMMON/DL/IXRX,M,AA /FONT/JFONT
00400 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
00700 REAL DIS,CENTR,POS,STFF
00800 COMMON /STF/RSTFAC(-3/4),RSTJ2
00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000 COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01110 C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
01200 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01300 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01400 1 PUNCT,JY,RJ
01500 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01600 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
01700 1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(STEM,JQ(20))
01800 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01850 1,(RX4,JQ(19)),(J5X,RZTM)
01900 DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
02000 1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02100 1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02200 1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02300 1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02400 1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02500 1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02600 1 18.103, 12.003, 6.103, 0.003, 106.103/
02700 1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02800 1 1000.0, 7.007, 14.0, 7.107, 0, 1000.107, 14.007,
02900 1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
03000 DATA RDOT/1000.101, .102, 1.103, 2.103, 3.102, 3.101, 2., 1.,
03050 1 .101, 2.103, 2., .102, 3.102, 1., 1.103, 3.101, .102/
03100 1 ,RSTM/14.54/
03200 1 ,XAC/9,14,18,28,33,44,53/
03300 C ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
03400 DATA RACCI/6.0,1115.003, 110.007, 106.001,
03500 1 115.109, 115.021, 15.0, 1104.104, 118.108,
03600 1 1108.113, 108.016, 1104.008, 118.004,
03700 1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
03800 1, 1114.018, 114.107, 106.104/
03900 1 ,NACCI/1,7,16/
04000
04100 RST7=7.*RSTJ2
04200 RST3=3.*RSTJ2
04300 RSTX=RSTJ2
04400 C FOR MINIS AT 245
04500 RMINI=RSTJ2
04600 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
04700
04800 RINV=1
04810 RX4=R4
04900 IF(JA.EQ.1)GO TO 11
05000 IF(JA.EQ.9)GO TO 242
05100
05200 C NEXT IS FOR RESTS
05210 IF(IABS(J4).LT.480)GO TO 302
05220 C P4+500= USER-ADDED RESTS
05230 CALL EXTRA
05240 RETURN
05300 302 IF(R8.NE.0)J5=-2
05400 C R8 PUTS NUMBER OVER WHOLE REST ONLY.
05500 IF(J5.GT.1)R4=R4-2
05600 CC RA=R4
05700 R7=R6*10.
05800 C FOR DOTS
05850 IF(J5.GE.2)R3=R3-3.0*RSTJ2
05875 C SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
05900 202 CALL REST
06000 IF(J5.GT.1)GO TO 200
06100 IF(R7.EQ.0)RETURN
06200 201 RA=14
06300 R6=0
06400 IF(J5)RA=19
06500 R3=R3+RA*RSTJ2
06600 R4=8.+R4
06700 JA=9
06800 J5=7
06900 C IF P6=1 THE REST IS DOTTED
07000 CALL CENTX
07100 GO TO 242
07200 200 J5=J5-1
07300 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
07400 R4=R4+2.
07500 CALL RJBX(4.3)
07600 GO TO 202
07700
07800 29 RJX=R3
07900 RJY=CENTR+RSTJ2
08000 108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
08100 C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
08200 WHOLE=0
08210 RG=9
08220 IF(PLT)RG=17
08230 C DOESN'T FILL DOT ON DPY
08300 107 CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
08400 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
08500 IF(JA.EQ.1)GO TO 290
08600 IF(R7.GE.20.)GO TO 290
08700 RB=POS+52.*RSTJ2
08800 IF(RJY.NE.RB)GO TO 6241
08900 C WHERE IS RB USED LATER?
09000 RJY=RJY-12*RSTJ2
09100 GO TO 107
09200 C ABOVE FOR DOTS
09300 290 R7=R7-10.
09400 IF(R7.LT.10.)GO TO 1342
09500 RJX=RJX+RSTJ2*10.
09600 GO TO 107
09700
10000 C NOTES****
10200 11 CALL NTS
10300 IF(STEM)RETURN
10400 R4=RX4
23500
31500 1242 IF(R7.LT.10.)GO TO 1342
31600 C FOR DOTTED NOTE-- P7>9
31700 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
31800 C***↑↑↑↑↑ WAS 24. 11/74
31900 RJY=CENTR+RSTJ2
32000 IF(JY.EQ.10)GO TO 4322
32100 IF(JY.NE.30)GO TO 3322
32200 4322 RJX=RJX+RSTM
32300 C MOVES DOT TO LEFT
32400 3322 IF(MOD(J4,2).EQ.0)GO TO 108
32500 RX=RST7
32600 IF(JY.GE.20)RX=-RX
32700 3342 RJY=RJY+RX
32800 GO TO 108
32900 C JY=30= STEM UP, INTERVAL OF SECOND.
33000 1342 IF(J5.NE.0)GO TO 5322
33100 IF(R6.EQ.0)RETURN
33200 5322 R3=R3-R5*59.6*RMINI
33300 C TO SPACE OUT ACCIDS.
33400 CCXX IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
33500 C ↑↑↑↑ ↑↑↑↑↑ WAS RMINI
33600 C********* 18/9/72
33700 242 IF(J5.GE.0)GO TO 2421
33800 RINV=-RINV
33900 J5=-J5
34000 C NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
34100 C********** LAST # WAS 281?
34200 C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
34300 CXX 11/74 2421 RH=14
34400 2421 J5X=-1
34500 JAX=JA
34600 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
34700 IF(JA.EQ.9)GO TO 2423
34800 IF(J5.GT.3)GO TO 3121
34900 C DBL FLT(4) AND DBL SHRP(5) ALWAYS USE 'DRAW' ROUTINE.
35000 GO TO 211
35100 2423 RJZ=R4
35200 C FOR 'DRWNT' WHEN PLOTTING.
35300 CALL NOZERO(R6)
35400 C R6=SIZE FACTOR (P6)
35500 RMINI=RMINI*R6
35600 R6=0
35700 STEM=0
35800 C FOR MISC. ITEMS
35900 210 IF(IABS(J4).LT.100)GO TO 1241
36000 CC210 IF(IABS(J4).LT.100)GO TO 3241
36100 J4=MOD(J4,100)
36200 RMINI=.7*RMINI
36300 CC3421 J5X=-1
36400 C FOR 2 MARKS AT ONCE.
36500 1241 IF(J5.GE.11)GO TO 28
36600 GO TO (211,211,211,28,28,222,249,60,27,27),J5
36700 RETURN
36800 C ERROR TRAP (I.E. J5=0)
36900 C FOR 1 OR 2 BAR REP SIGNS.
37000 60 CALL BREP
37100 RETURN
37200
37300 241 CALL LINES(R3,CENTR,3)
37400 GO TO 210
37500
37600
37700 211 IF(J5.EQ.0)GO TO 2422
37800 C GETS BACK GOOD VERTICAL POS.
37900 IF(J5.GT.3)GO TO 222
38000 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
38100 IF(PLT)GO TO 3121
38200 IF(JFONT.NE.0)GO TO 3121
38300 X=NACCI(J5)
38400 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
38500 2422 IF(R6.EQ.0)RETURN
38600 J5=(R6+.001)*100.
38700 R4=RX4
38800 CC R4=RJZ
38900 R3=RJAC
39000 1249 IF(MOD(J5,10).GT.3)GO TO 249
39100 J5=J5/10
39200 IF(J5.GT.30)GO TO 1249
39300 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
39400 249 IF(J5.GT.30)GO TO 28
39500 IF(J5.GT.10)GO TO 246
39600 IF(J5.EQ.0)RETURN
39700 IF(JA.NE.1)GO TO 250
39800 CXX 11/74 RH=8
39900 RB=14.
40000 IF(MOD(J4,2).EQ.0)GO TO 244
40100 IF(J5.EQ.7)GO TO 6322
40200 IF(J5.NE.9)GO TO 244
40300 6322 IF(STEM.GT.1)GO TO 7322
40400 IF(J4.LT.5)GO TO 244
40500 7322 IF(J4.LE.9)GO TO 8322
40600 IF(STEM.EQ.2)GO TO 244
40700 IF(STEM.EQ.0)GO TO 244
40800 8322 RB=21
40900 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
41000 244 IF(STEM.EQ.1)GO TO 9322
41100 IF(STEM.NE.0)GO TO 245
41200 IF(J4.GE.7)GO TO 245
41300 9322 RB=-RB
41400 CC IF(J5.NE.6)GO TO 245
41500 CC IF(J4.LT.9.AND.STEM.EQ.2)GO TO 281
41600 CC IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
41700 245 CENTR=CENTR+RB*RSTX
41800 250 IF(J5.GT.10)GO TO 281
41900 IF(J5.LT.6)GO TO 281
42000 JA=9
42100 IF(J5.NE.7)GO TO 253
42200 C 7=DOT
42300 RXX=R3
42400 R3=R3+6.7*RMINI
42500 C CENTERS THE DOT
42600 GO TO 29
42700 253 IF(J5.EQ.9)GO TO 271
42800 C 9=DASH
42900 251 IF(RB.LT.0)RINV=-RINV
43000 C FIX THIS!!!! FOR BOWINGS, ETC.
43100 2222 IF(J5.NE.20)GO TO 2223
43200 CZZZZZZZZZZZ
43300 JA=7
43400 R5=0
43500 J7=1
43600 CALL ALPHA
43700 C FOR TRILL -- J5=20
43800 RETURN
43900 2223 IF(J5.EQ.17)GO TO 323
44000 IF(J5.NE.18)GO TO 222
44100 323 RINV=J5
44200 C FOR MORD, INV.MORD
44300 222 CALL FERMTA
44400 GO TO 5241
44500 252 RX=POS
44600 248 CENTR=RX
44700 GO TO 251
44800 246 IF(J5.LT.10)GO TO 245
44900 CC R4=R4+3
45000 CC IF(STEM.EQ.1)R4=R4+6.+R8
45020 RZ=3
45040 IF(STEM.EQ.1)RZ=9+R8
45060 R4=R4+RZ*RMINI/RSTJ2
45100 IF(R4.LT.12.5)R4=12.5
45200 CALL CENTX
45300 IF(J5.EQ.26)GO TO 222
45400 C 26 IS NEW NUMB FOR FERMATA.
45500 28 IF(J5.LT.30)GO TO 281
45600 J5X=MOD(J5,10)
45700 C J5X SAVES NEXT MARK.
45800 IF(J5X.LT.4)J5X=0
45900 J5=J5/10
46000 IF(J5.GT.30)RETURN
46100 C WON'T READ 415 ETC. (CORRECT=154)
46200 C DOES BOTTOM MARK FIRST, THEN TOP.
46300 CALL EXCH(J5X,J5)
46400 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
46500 IF(JA.EQ.1)GO TO 249
46600 GO TO 1241
46700 281 X=1
46800 IF(J5.GT.16)GO TO 2222
46900 C JUMP FOR MORD, INV.MORD, TRILL
47000 IF(J5.NE.4)GO TO 228
47100 X=5
47200 CALL RJBX(.5)
47300 GO TO 328
47400 228 IF(J5.GT.10)X=XAC(J5-10)
47500 C X IS POINTER IN RACNT ARRAY
47600 328 RA=RMINI
47700 C OR RSTJ2?
47800 IF(RINV.LT.0)GO TO 1323
47900 IF(STEM.NE.1)GO TO 2323
48000 IF(J5.NE.4)GO TO 2323
48100 1323 RA=-RA
48200 C ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
48300 2323 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
48400 C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
48500 C IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
48600 GO TO 5241
48700 4241 JJJ=J5
48800 J5=J5X
48900 J5X=-1
49000 IF(JAX.NE.1)GO TO 7241
49100 IF(J5.GT.10)GO TO 246
49200 IF(J5.NE.7)GO TO 7241
49300 IF(JJJ.NE.9)GO TO 249
49400 7241 RXX=8.5*RMINI
49500 C↑↑↑↑↑↑ 11/74 WAS RH*
49600 IF(STEM.EQ.1)RXX=-RXX
49700 CENTR=CENTR+RXX
49800 IF(J5.EQ.26)J5=6
49900 C TEMPORARY?? FIX
50000 GO TO 1241
50100 C >=5, ∧=4
50200 27 R3=J3
50300 C DASHES
50400 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
50500 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
50600 5241 IF(J5X.GT.0)GO TO 4241
50700 C J5X IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
50800 RETURN
50900 6241 R3=RXX
51000 C RESET R3 AFTER A DOT.
51100 GO TO 5241
51200 3121 J5=J5+9
51300 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
51400 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
51500 CALL DRWNT
51600 GO TO 2422
51700 END